home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / TCPUtils.p < prev   
Text File  |  1995-10-23  |  10KB  |  358 lines
  1. unit TCPUtils;
  2.  
  3. interface
  4.  
  5.     uses
  6.         TCPTypes;
  7.         
  8.     var
  9.         mactcp_driver_refnum:integer;
  10.  
  11.     type
  12.         TCPXControlBlock = record
  13.                 completion: ProcPtr;
  14.                 pb: TCPControlBlock;
  15.             end;
  16.         TCPXControlBlockPtr = ^TCPXControlBlock;
  17.  
  18.         TCPStateType = (T_WaitingForOpen, T_Dead, T_Bored, T_Opening, T_Established,
  19.             T_Closing, T_PleaseClose, T_Unknown);
  20. { T_Bored means listening or closed }
  21.  
  22.     type
  23.         DNRCompletionProcPtr = ProcPtr;
  24. { procedure DNRCompletionProc(drp:DNRRecordPtr); }
  25.         DNRRecord = record
  26. { Generally you only need to look at the first three of these }
  27.                 ioResult: OSErr;
  28.                 name: Str255;
  29.                 addr: longint;
  30.                 completion: DNRCompletionProcPtr;
  31.                 case integer of
  32.                     1: (
  33.                             hi: hostInfo;
  34.                     );
  35.                     2: (
  36.                             hmx: hmxInfoRec;
  37.                     );
  38.                     3: (
  39.                             cacherec: cacheEntryRecord;
  40.                     );
  41.             end;
  42.         DNRRecordPtr = ^DNRRecord;
  43.  
  44.     procedure StartupTCPUtils;
  45.     
  46.     function MTTCPCreate(var stream:StreamPtr; buffer:Ptr; buffer_size:longint):OSErr;
  47.     function MTTCPRelease(var stream:StreamPtr):OSErr;
  48.     function MTTCPActiveOpen(var cb:TCPControlBlock; stream:StreamPtr; local_port: integer; remote_ip: longint; remote_port: integer):OSErr;
  49.     function MTTCPPassiveOpen(var cb:TCPControlBlock; stream:StreamPtr; var local_port: integer):OSErr;
  50.     function MTTCPClose(var cb:TCPControlBlock; stream:StreamPtr):OSErr;
  51.     function MTTCPAbort(stream:StreamPtr):OSErr;
  52.     function MTTCPState(stream:StreamPtr):TCPStateType;
  53.  
  54.     function MTUDPCreate(var stream:StreamPtr; var localport: integer; outstanding_count_ptr: LongIntPtr; buffer:Ptr; buffer_size:longint):OSErr;
  55.     function MTUDPRelease (stream:StreamPtr): OSErr;
  56.     function MTUDPRead (stream:StreamPtr; outstanding_count_ptr: LongIntPtr; var remoteIP: longint; var remoteport: integer;
  57.                                     var datap: ptr; var datalen: integer): OSErr;
  58.     function MTUDPReturnBuffer (stream:StreamPtr; datap: ptr): OSErr;
  59.     function MTUDPWrite (stream:StreamPtr; remoteIP: longint; remoteport: integer;
  60.                                     datap: ptr; datalen: integer; checksum: boolean): OSErr;
  61.  
  62.     procedure SanitizeHostName (var s: Str255);
  63.  
  64.     procedure DNRNameToAddr (name: Str255; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  65.     procedure DNRAddrToName (addr: longint; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  66.  
  67.     procedure MTZeroTCPCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
  68.     procedure MTZeroUDPCB (var cb: UDPControlBlock; stream: StreamPtr; call: integer);
  69.  
  70. implementation
  71.     
  72.     uses
  73.         Devices, MyCStrings, MyCallProc, DNR, MyMemory, MyStartup;
  74.         
  75.     var
  76.         gDNRNameToAddrCompletionProc:UniversalProcPtr;
  77.         gDNRAddrToNameCompletionProc:UniversalProcPtr;
  78.         gUDPNotifyProc:UniversalProcPtr;
  79.         
  80.     procedure MTZeroTCPCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
  81.     begin
  82.         MZero(@cb, SizeOf(cb));
  83.         cb.tcpStream := stream;
  84.         cb.ioCRefNum := mactcp_driver_refnum;
  85.         cb.csCode := call;
  86.     end;
  87.  
  88.     procedure MTZeroUDPCB (var cb: UDPControlBlock; stream: StreamPtr; call: integer);
  89.     begin
  90.         MZero(@cb, SizeOf(cb));
  91.         cb.udpStream := stream;
  92.         cb.ioCRefNum := mactcp_driver_refnum;
  93.         cb.csCode := call;
  94.     end;
  95.  
  96.     function MTTCPCreate(var stream:StreamPtr; buffer:Ptr; buffer_size:longint):OSErr;
  97.         var
  98.             err:OSErr;
  99.             cb:TCPControlBlock;
  100.     begin
  101.         MTZeroTCPCB(cb, nil, TCPcsCreate);
  102.         cb.create.rcvBuff := buffer;
  103.         cb.create.rcvBuffLen := buffer_size;
  104.         err := PBControlSync(@cb);
  105.         if err = noErr then begin
  106.             stream := cb.tcpStream;
  107.         end else begin
  108.             stream := nil;
  109.         end;
  110.         MTTCPCreate := err;
  111.     end;
  112.     
  113.     function MTTCPRelease(var stream:StreamPtr):OSErr;
  114.         var
  115.             cb:TCPControlBlock;
  116.     begin
  117.         MTZeroTCPCB(cb, stream, TCPcsRelease);
  118.         MTTCPRelease := PBControlSync(@cb);
  119.         stream := nil;
  120.     end;
  121.  
  122.     function MTTCPActiveOpen(var cb:TCPControlBlock; stream:StreamPtr; local_port: integer; remote_ip: longint; remote_port: integer):OSErr;
  123.     begin
  124.         MTZeroTCPCB(cb, stream, TCPcsActiveOpen);
  125.         cb.open.localPort := local_port;
  126.         cb.open.remoteHost := remote_ip;
  127.         cb.open.remotePort := remote_port;
  128.         cb.open.ulpTimeoutAction := -1;
  129.         MTTCPActiveOpen := PBControlAsync(@cb);
  130.     end;
  131.  
  132.     function MTTCPPassiveOpen(var cb:TCPControlBlock; stream:StreamPtr; var local_port: integer):OSErr;
  133.         var
  134.             err:OSErr;
  135.     begin
  136.         MTZeroTCPCB(cb, stream, TCPcsPassiveOpen);
  137.         cb.open.localPort := local_port;
  138.         cb.open.ulpTimeoutAction := -1;
  139.         err := PBControlAsync(@cb);
  140.         if err = noErr then begin
  141.             while (cb.ioResult>=0) & (cb.open.localPort=0) do begin
  142.                 ;
  143.             end;
  144.             local_port:=cb.open.localPort;
  145.         end;
  146.         MTTCPPassiveOpen := err;
  147.     end;
  148.     
  149.     function MTTCPClose(var cb:TCPControlBlock; stream:StreamPtr):OSErr;
  150.     begin
  151.         MTZeroTCPCB(cb, stream, TCPcsClose);
  152.         MTTCPClose := PBControlAsync(@cb);
  153.     end;
  154.  
  155.     function MTTCPAbort(stream:StreamPtr):OSErr;
  156.         var
  157.             cb:TCPControlBlock;
  158.     begin
  159.         MTZeroTCPCB(cb, stream, TCPcsAbort);
  160.         MTTCPAbort := PBControlSync(@cb);
  161.     end;
  162.  
  163.     function MTTCPState(stream:StreamPtr):TCPStateType;
  164.         var
  165.             err:OSErr;
  166.             cb:TCPControlBlock;
  167.     begin
  168.         MTZeroTCPCB(cb, stream, TCPcsStatus);
  169.         err := PBControlSync(@cb);
  170.         MTTCPState := T_Dead;
  171.         if err = noErr then begin
  172.             case cb.status.connectionState of
  173.                 0: 
  174.                     MTTCPState := T_Dead;
  175.                 2: 
  176.                     MTTCPState := T_Bored;
  177.                 4, 6: 
  178.                     MTTCPState := T_Opening;
  179.                 8: 
  180.                     MTTCPState := T_Established;
  181.                 10, 12, 16, 18, 20: 
  182.                     MTTCPState := T_Closing;
  183.                 14: 
  184.                     MTTCPState := T_PleaseClose;
  185.                 otherwise begin
  186.                     MTTCPState := T_Unknown;
  187.                 end;
  188.             end;
  189.         end;
  190.     end;
  191.     
  192.     procedure SanitizeHostName (var s: Str255);
  193.     begin
  194.         C2P(@s);
  195.         if s[Length(s)] = '.' then begin
  196.             s[0] := chr(Length(s) - 1);
  197.         end;
  198.     end;
  199.  
  200.     procedure DNRNameToAddrCompletion (hip: hostInfoPtr; drp: DNRRecordPtr);
  201.     begin
  202.         drp^.ioResult := hip^.rtnCode;
  203.         drp^.addr := drp^.hi.addrs[1];
  204.         if drp^.completion <> nil then begin
  205.             CallPascal04(drp, drp^.completion);
  206.         end;
  207.     end;
  208.  
  209.     procedure DNRNameToAddr (name: Str255; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  210.         var
  211.             err: OSErr;
  212.     begin
  213.         drp^.ioResult := 1;
  214.         drp^.name := name;
  215.         drp^.completion := completion;
  216.         err := StrToAddr(name, drp^.hi, gDNRNameToAddrCompletionProc, ptr(drp));
  217.         if err <> cacheFaultErr then begin
  218.             drp^.hi.rtnCode := err;
  219.             DNRNameToAddrCompletion(@drp^.hi, drp);
  220.         end;
  221.     end;
  222.  
  223.     procedure DNRAddrToNameCompletion (hip: hostInfoPtr; drp: DNRRecordPtr);
  224.     begin
  225.         drp^.ioResult := hip^.rtnCode;
  226.         if drp^.ioResult = noErr then begin
  227.             BlockMoveData(@hip^.rtnHostName, @drp^.name, SizeOf(drp^.name));
  228.             SanitizeHostName(drp^.name);
  229.         end;
  230.         if drp^.completion <> nil then begin
  231.             CallPascal04(drp, drp^.completion);
  232.         end;
  233.     end;
  234.  
  235.     procedure DNRAddrToName (addr: longint; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  236.         var
  237.             err: OSErr;
  238.     begin
  239.         drp^.ioResult := 1;
  240.         drp^.addr := addr;
  241.         drp^.completion := completion;
  242.         AddrToStr(addr, drp^.name);
  243.         err := AddrToName(addr, drp^.hi, gDNRAddrToNameCompletionProc, ptr(drp));
  244.         if err <> cacheFaultErr then begin
  245.             drp^.hi.rtnCode := err;
  246.             DNRAddrToNameCompletion(@drp^.hi, drp);
  247.         end;
  248.     end;
  249.  
  250.     procedure UDPNotify (stream: streamPtr; eventCode: integer; outstanding_count_ptr: LongIntPtr; icmpMsg: ptr);
  251.     begin
  252.         stream := stream; { Unused! }
  253.         icmpMsg := icmpMsg; { Unused! }
  254.         if eventCode = UDPDataArrival then begin
  255.             if outstanding_count_ptr <> nil then begin
  256.                 Inc(outstanding_count_ptr^);
  257.             end;
  258.         end;
  259.     end;
  260.  
  261.     function MTUDPCreate(var stream:StreamPtr; var localport: integer; outstanding_count_ptr: LongIntPtr; buffer:Ptr; buffer_size:longint):OSErr;
  262.         var
  263.             err: OSErr;
  264.             cb: UDPControlBlock;
  265.     begin
  266.         MTZeroUDPCB(cb, nil, UDPcsCreate);
  267.         if outstanding_count_ptr <> nil then begin
  268.             outstanding_count_ptr^ := 0;
  269.         end;
  270.         cb.create.rcvBuff := buffer;
  271.         cb.create.rcvBuffLen := buffer_size;
  272.         cb.create.notifyProc := gUDPNotifyProc;
  273.         cb.create.userDataPtr := Ptr(outstanding_count_ptr);
  274.         cb.create.localport := localport;
  275.         err := PBControlSync(@cb);
  276.         if err = noErr then begin
  277.             localport := cb.create.localport;
  278.             stream := cb.udpStream;
  279.         end else begin
  280.             stream := nil;
  281.         end;
  282.         MTUDPCreate := err;
  283.     end;
  284.  
  285.     function MTUDPRelease (stream:StreamPtr): OSErr;
  286.         var
  287.             err: OSErr;
  288.             cb: UDPControlBlock;
  289.     begin
  290.         MTZeroUDPCB(cb, stream, UDPcsRelease);
  291.         err := PBControlSync(@cb);
  292.         MTUDPRelease := err;
  293.     end;
  294.  
  295.     function MTUDPRead (stream:StreamPtr; outstanding_count_ptr: LongIntPtr; var remoteIP: longint; var remoteport: integer;
  296.                                     var datap: ptr; var datalen: integer): OSErr;
  297.         var
  298.             err: OSErr;
  299.             cb: UDPControlBlock;
  300.     begin
  301.         MTZeroUDPCB(cb, stream, UDPcsRead);
  302.         err := PBControlSync(@cb);
  303.         if (err = noErr) & (outstanding_count_ptr <> nil) then begin
  304.             Dec(outstanding_count_ptr^);
  305.         end;
  306.         remoteIP := cb.receive.remoteIP;
  307.         remoteport := cb.receive.remoteport;
  308.         datap := cb.receive.rcvBuff;
  309.         datalen := cb.receive.rcvBuffLen;
  310.         MTUDPRead := err;
  311.     end;
  312.  
  313.     function MTUDPReturnBuffer (stream:StreamPtr; datap: ptr): OSErr;
  314.         var
  315.             err: OSErr;
  316.             cb: UDPControlBlock;
  317.     begin
  318.         MTZeroUDPCB(cb, stream, UDPcsBfrReturn);
  319.         cb.return.rcvBuff := datap;
  320.         err := PBControlSync(@cb);
  321.         MTUDPReturnBuffer := err;
  322.     end;
  323.  
  324.     function MTUDPWrite (stream:StreamPtr; remoteIP: longint; remoteport: integer;
  325.                                     datap: ptr; datalen: integer; checksum: boolean): OSErr;
  326.         var
  327.             err: OSErr;
  328.             cb: UDPControlBlock;
  329.             wds: wdsType;
  330.     begin
  331.         MTZeroUDPCB(cb, stream, UDPcsWrite);
  332.         cb.send.remoteIP := remoteIP;
  333.         cb.send.remotePort := remoteport;
  334.         wds.size := datalen;
  335.         wds.buffer := datap;
  336.         wds.term := 0;
  337.         cb.send.wds := @wds;
  338.         cb.send.checksum := ord(checksum);
  339.         err := PBControlSync(@cb);
  340.         MTUDPWrite := err;
  341.     end;
  342.  
  343.     function InitTCPUtils(var msg: integer): OSStatus;
  344.     begin
  345.         msg := msg; { Unused }
  346.         gDNRNameToAddrCompletionProc := NewProc(@DNRNameToAddrCompletion,uppPascal044ProcInfo);
  347.         gDNRAddrToNameCompletionProc := NewProc(@DNRAddrToNameCompletion,uppPascal044ProcInfo);
  348.         gUDPNotifyProc := NewProc(@UDPNotify,uppPascal04244ProcInfo);
  349.         InitTCPUtils := noErr;
  350.     end;
  351.  
  352.     procedure StartupTCPUtils;
  353.     begin
  354.         SetStartup(InitTCPUtils, nil, 0, nil);
  355.     end;
  356.     
  357. end.
  358.